(* Copyrights by Kenneth Lee, 2024. All Rights Reserved 

   原理：创建一个列表，每个列表节点的内容包括剩余的数字列表和一个用作日志的字符串。
   比如我们要算1,2,3,4的，一开始列表中就只有一个元素[([1;2;3;4], "")]，
   我们把这种元素称为一个可能性节点。其中包含的数字数量称为这个可能性节点的level（级别）。
   我们的递归过程是就是不断降低列表中可能性节点的级别的过程，比如，上面这个节点，
   我们降一级，它就变成：

          [([3;3;4], "1+2=3");
           ([-1;3;4], "1-2=-1");
           ([1;3;4], "2-1=1");
           ...]

   这样下去，只要把所有可能性节点的级别都降到1，然后我们判断一下这个结果是不是24就知
   道这个可能性节点是否是可以得到24的一种可能性了。日志里面也包含了如何得到结果的过
   程了。
*)

open Printf

(* 异常情况都不处理，用这个异常代替 *)
exception Err of string

(* 没有依赖的公共函数放出来比较适合，这样好单独调试 *)

(* 从l中删除等于e的第一个元素 *)
let remove_f_from_list e l =
let rec remove_f_from_list_r e l n = match l with (* 尾递归版本 *)
  []   -> n                                       (* 递归结束，返回收集的所有结果 *)
| h::t -> if h = e then n@t                       (* 找到了，返回中间结果加上剩下的元素 *)
                   else remove_f_from_list_r e t (n@[h])  (* 没找到，继续找，当前头放中间结果中 *)
in remove_f_from_list_r e l []                    (* 调用尾递归版本，中间结果先放空 *)

(* 从可能性列表中求level *)
let get_level m_input = match m_input with 
  [] -> raise (Err "Level become 0")
| (nums,es)::t -> (List.length nums)

let rec print_m_input m_input = match m_input with
[] -> ()
| (nums, es)::t -> printf "%s\n" es ; print_m_input t

let remove_duplicate ls =
let rec remove_duplicate_r ls n = match ls with
| [] -> n
| h::t -> remove_duplicate_r t (if List.exists ((=) h) n then n else h::n)
in remove_duplicate_r ls []


(* 从输入或者中间结果中不断降低level，直到只剩下一个结果，从而判断是否等于24 *)
let rec find_solutions m_input = match (get_level m_input) with
| 1 ->  (* 剩下最后一个值，去掉非24的部分就是结果 *)
  List.find_all (fun (nums,es) -> match nums with [] -> raise (Err "over reduce") | h::_ -> h=24.) m_input

| _ -> (* 还可以合并，继续 *)

  (* 尾递归：对m_input每个节点降级，补上已经降级的new_m_input作为输出 *)
  let rec reduce_m_input m_input new_m_input  =

  (* 对一个可能性节点降级，返回多个降级的可能性节点的列表 *)
  let reduce_one (nums,es) =

      (* 尾递归：每个e和ls中成员的组合进行合并，合并结果加到n中积累 *)
      let rec gen_list e ls n = match ls with
        []   -> n (* 列表为空，无法进一步进行组合，返回积累的n *)
      | h::t ->   (* 列表非空，让e每次和一个h进行组合，直到穷尽t即可 *)

         let pair n1 n2 =
           let nums = remove_f_from_list n1 nums in  (* 从nums中去掉num和h *)
           let nums = remove_f_from_list n2 nums in
           (* 用不同方法合并n1/n2，生成多个节点，更新合并日志 *)
           let n = ((n1+.n2)::nums, sprintf "%s|(%.2f+%.2f)->%.2f" es n1 n2 (n1+.n2)) :: 
                   ((n1*.n2)::nums, sprintf "%s|(%.2f*%.2f)->%.2f" es n1 n2 (n1*.n2)) :: n
           in
           let n = if n1=n2 then
                   ((n1-.n2)::nums, sprintf "%s|(%.2f-%.2f)->%.2f" es n1 n2 (n1-.n2)) :: n
           else
                   ((n1-.n2)::nums, sprintf "%s|(%.2f-%.2f)->%.2f" es n1 n2 (n1-.n2)) ::
                   ((n2-.n1)::nums, sprintf "%s|(%.2f-%.2f)->%.2f" es n2 n1 (n2-.n1)) :: n
           in
           let n = if n1 <> 0. then ((n2/.n1)::nums, sprintf "%s|(%.2f/%.2f)->%.2f|" es n2 n1 (n2/.n1)) :: n else n in
           let n = if n2 <> 0. && n1 <> n2 then ((n1/.n2)::nums, sprintf "%s|(%.2f/%.2f)->%.2f|" es n1 n2 (n1/.n2)) :: n else n in
           n  (* 返回生成的节点，这是pair_h_t h::t分支的返回值，包含num和num_ls所有合并的节点 *)
         in (* 这里终止pair的定义 *)

         (* gen_list的递归分支，t是降低后的列表，最后补上用 *)
         gen_list e t (remove_duplicate (n @ (pair e h)))             (* 这里进行gen_list的下一级递归，(nums,es)保持不变，
                                                      中间结果中包含上用pair_h_t制造的h t所有组合生成的节点 *)
    in (* 这里终止gen_list的定义 *)

    (* 这里开始定义reduce_one (nums, es)，它不递归，仅展开一个节点 *)
    match nums with
      []   -> raise (Err "over reduce_one (may you give no input?")     (* 异常处理，nums中总应该有数据 *)
    | h::t -> gen_list h t []                       (* 调用gen_list求h和t中每个元素的组合，返回展开列表 *)

    in (* 这终止reduce_one的定义 *)

    (* reduce_m_input的定义 *)
    match m_input with                              (* 靠递归遍历m_input *)
      []   -> new_m_input                           (* m_input空了，结果都在new_m_input中了 *)
    | h::t -> reduce_m_input t ((reduce_one h) @ new_m_input)  (* m_input中有一个值h，展开它到new_m_input中，
                                                                  然后递归剩下的t *)
  in

  (* 递归，向下降一级 *)
  find_solutions (reduce_m_input m_input [])

(* 这里开始是主程序 *)
let input = 
  let argc = Array.length Sys.argv in
  let argv = Array.sub Sys.argv 1 (argc - 1)
  in List.map int_of_string (Array.to_list argv)
let m_input = List.map (fun i -> Float.of_int i) input (* 计算过程用浮点算 *)
let m_input = [m_input, ""]                      (* 增加一个字符串记录计算过程 *)
let solutions = find_solutions m_input
let input_to_string ls =
  let rec input_to_string_r ls s = match ls with
  [] -> s | h::t -> input_to_string_r t s^(string_of_int h)^" "
in input_to_string_r ls "" 

(* 输出计算结果 *)
let () = 
  printf "found solutions for (%s): \n" (input_to_string input); 
  print_m_input solutions
